home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / perl5 / URI / mailto.pm < prev    next >
Text File  |  2008-04-02  |  1KB  |  73 lines
  1. package URI::mailto;  # RFC 2368
  2.  
  3. require URI;
  4. require URI::_query;
  5. @ISA=qw(URI URI::_query);
  6.  
  7. use strict;
  8.  
  9. sub to
  10. {
  11.     my $self = shift;
  12.     my @old = $self->headers;
  13.     if (@_) {
  14.     my @new = @old;
  15.     # get rid of any other to: fields
  16.     for (my $i = 0; $i < @new; $i += 2) {
  17.         if (lc($new[$i] || '') eq "to") {
  18.         splice(@new, $i, 2);
  19.         redo;
  20.         }
  21.     }
  22.  
  23.     my $to = shift;
  24.     $to = "" unless defined $to;
  25.     unshift(@new, "to" => $to);
  26.     $self->headers(@new);
  27.     }
  28.     return unless defined wantarray;
  29.  
  30.     my @to;
  31.     while (@old) {
  32.     my $h = shift @old;
  33.     my $v = shift @old;
  34.     push(@to, $v) if lc($h) eq "to";
  35.     }
  36.     join(",", @to);
  37. }
  38.  
  39.  
  40. sub headers
  41. {
  42.     my $self = shift;
  43.  
  44.     # The trick is to just treat everything as the query string...
  45.     my $opaque = "to=" . $self->opaque;
  46.     $opaque =~ s/\?/&/;
  47.  
  48.     if (@_) {
  49.     my @new = @_;
  50.  
  51.     # strip out any "to" fields
  52.     my @to;
  53.     for (my $i=0; $i < @new; $i += 2) {
  54.         if (lc($new[$i] || '') eq "to") {
  55.         push(@to, (splice(@new, $i, 2))[1]);  # remove header
  56.         redo;
  57.         }
  58.     }
  59.  
  60.     my $new = join(",",@to);
  61.     $new =~ s/%/%25/g;
  62.     $new =~ s/\?/%3F/g;
  63.     $self->opaque($new);
  64.     $self->query_form(@new) if @new;
  65.     }
  66.     return unless defined wantarray;
  67.  
  68.     # I am lazy today...
  69.     URI->new("mailto:?$opaque")->query_form;
  70. }
  71.  
  72. 1;
  73.